home *** CD-ROM | disk | FTP | other *** search
/ SPACE 2 / SPACE - Library 2 - Volume 1.iso / music / 7 / modula / diamnd.mod < prev    next >
Text File  |  1985-11-19  |  2KB  |  81 lines
  1. IMPLEMENTATION MODULE Diamond ;
  2.  
  3. (* TDI MOSYS Atari 520 ST : Recursive diamond *)
  4. (* (c) TDI Software Ltd. 1985. *)
  5.  
  6. FROM GEMVDIbase IMPORT
  7.      (* types *) VDIWorkInType, VDIWorkOutType;
  8.  
  9. FROM VDIOutputs IMPORT
  10.      (* procs *) PolyLine ;
  11.  
  12. FROM VDIControls IMPORT
  13.      (* procs *) OpenVirtualWorkstation, CloseVirtualWorkstation ;
  14.  
  15. FROM AESGraphics IMPORT
  16.      (* procs *) GrafHadle;
  17.  
  18. FROM GemDem IMPORT
  19.      (* vars  *) WorkX, WorkY ;
  20.  
  21. VAR currentX, currentY : INTEGER;
  22.     Point              : ARRAY [0..3] OF INTEGER;
  23.  
  24.  
  25.  
  26. PROCEDURE MoveTo (x, y : INTEGER);
  27.  
  28. BEGIN
  29.   currentX := x;
  30.   currentY := y;
  31. END MoveTo;
  32.  
  33.  
  34. PROCEDURE LineTo (toX, toY : INTEGER);
  35.  
  36. BEGIN
  37.   Point [0] := currentX;
  38.   Point [1] := currentY;
  39.   Point [2] := toX;
  40.   Point [3] := toY;
  41.   MoveTo (toX, toY); (* remember to change currentX, currentY *)
  42.   PolyLine (handle, 2, Point);
  43. END LineTo;
  44.  
  45.  
  46. PROCEDURE D ( x, y, s : INTEGER );
  47.  
  48. BEGIN
  49.   IF s < m THEN RETURN END;
  50.   s := s DIV 2;
  51.   D (x+s, y, s);
  52.   D (x-s, y, s);
  53.   D (x, y-s, s);
  54.   D (x, y+s, s);
  55.   MoveTo (x, y+s);
  56.   LineTo (x+s, y);
  57.   LineTo (x, y-s);
  58.   LineTo (x-s, y);
  59.   LineTo (x, y+s);
  60. END D;
  61.    
  62. VAR handle : INTEGER;
  63.     j      : INTEGER;
  64.     m      : INTEGER;
  65.     In     : VDIWorkInType;
  66.     Out    : VDIWorkOutType;
  67.  
  68. PROCEDURE DoDiamond ;
  69. BEGIN
  70.   currentX := WorkX; currentY := WorkY;
  71.   FOR j := 0 TO 9 DO In [j] := 1 END;
  72.   In [10] := 2;
  73.   handle := GrafHandle (j, j, j, j);
  74.   OpenVirtualWorkstation (In, handle, Out);
  75.   m := 2;  (* dropped from 6 to 2 to accomodate lo rez  *)
  76.   D ( 150, 105, 70 );  (* first dim /2 & -30 halved to accomodate low rez  *)
  77.   CloseVirtualWorkstation (handle);
  78. END DoDiamond ;
  79.  
  80. END Diamond.
  81. əəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəəə